home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue57 / DragDrop / DragButton.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-02-11  |  2.3 KB  |  108 lines
  1. unit DragButton;
  2.  
  3. {$ifdef Ver90} { Delphi 2.0x }
  4.   {$define DelphiLessThan3}
  5.   {$define DelphiLessThan4}
  6. {$endif}
  7. {$ifdef Ver93} { C++ Builder 1.0x }
  8.   {$define DelphiLessThan3}
  9.   {$define DelphiLessThan4}
  10. {$endif}
  11. {$ifdef Ver100} { Delphi 3.0x }
  12.   {$define DelphiLessThan4}
  13. {$endif}
  14. {$ifdef Ver110} { C++ Builder 3.0x }
  15.   {$define DelphiLessThan4}
  16. {$endif}
  17.  
  18. interface
  19.  
  20. uses
  21.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  22.   StdCtrls;
  23.  
  24. type
  25.   TDragButton = class(TButton)
  26.   private
  27. {$ifdef DelphiLessThan4}
  28.     FDragImages: TImageList;
  29. {$else}
  30.     FDragImages: TDragImageList;
  31. {$endif}
  32.   protected
  33. {$ifdef DelphiLessThan4}
  34.     function GetDragImages: TCustomImageList; override;
  35. {$else}
  36.     function GetDragImages: TDragImageList; override;
  37. {$endif}
  38.     procedure MouseDown(Button: TMouseButton;
  39.       Shift: TShiftState; X, Y: Integer); override;
  40.   public
  41.     constructor Create(AOwner: TComponent); override;
  42.   end;
  43.  
  44. procedure Register;
  45.  
  46. implementation
  47.  
  48. procedure Register;
  49. begin
  50.   RegisterComponents('Clinic', [TDragButton]);
  51. end;
  52.  
  53. { TDragButton }
  54.  
  55. constructor TDragButton.Create(AOwner: TComponent);
  56. begin
  57.   inherited Create(AOwner);
  58.   ControlStyle := ControlStyle + [csDisplayDragImage]
  59. end;
  60.  
  61. {$ifdef DelphiLessThan4}
  62. function TDragButton.GetDragImages: TCustomImageList;
  63. {$else}
  64. function TDragButton.GetDragImages: TDragImageList;
  65. {$endif}
  66. var
  67.   Bmp: TBitmap;
  68. begin
  69.   if not Assigned(FDragImages) then
  70.   {$ifdef DelphiLessThan4}
  71.     FDragImages := TImageList.Create(Self);
  72.   {$else}
  73.     FDragImages := TDragImageList.Create(Self);
  74.   {$endif}
  75.   Bmp := TBitmap.Create;
  76.   try
  77.     Bmp.Width := Width;
  78.     Bmp.Height := Height;
  79.   {$ifndef DelphiLessThan3}
  80.     Bmp.Canvas.Lock;
  81.   {$endif}
  82.     try
  83.       PaintTo(Bmp.Canvas.Handle, 0, 0);
  84.     finally
  85.     {$ifndef DelphiLessThan3}
  86.       Bmp.Canvas.UnLock
  87.     {$endif}
  88.     end;
  89.     FDragImages.Width := Width;
  90.     FDragImages.Height := Height;
  91.     FDragImages.AddMasked(Bmp, clBtnFace);
  92.     Result := FDragImages;
  93.   finally
  94.     Bmp.Free
  95.   end
  96. end;
  97.  
  98. procedure TDragButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  99.   X, Y: Integer);
  100. begin
  101.   inherited;
  102.   //Automatically start dragging on a Ctrl-click
  103.   if ssCtrl in Shift then
  104.     BeginDrag(True)
  105. end;
  106.  
  107. end.
  108.